Session 3: Text and corpus data

The purpose of this notebook is to demonstrate some of what is possible for the mining and visualisation of a text. We’ll go through some of the basic tools and do some data visualisation to demonstrate what is possible. If this kind of analysis is not directly relevant to your research, hopefully you can use this time to practice different data visualisation techniques and become more familiar with seeking out answers to questions about programming R code.

1 Setting up

In this session, we’ll be using a few packages, but they’ll be introduced as we go. Firstly, we’ll need to load in tidyverse and tm (text mining). We will not explicitly be using SnowballC at this time, but it may be useful to know about as it helps with lemmatization for word frequency analysis in several languages. It is one of tm’s dependencies, and may be doing a bit of background work.

library(tidyverse)

── Attaching packages ─────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──
✔ ggplot2 2.2.1     ✔ purrr   0.2.5
✔ tibble  1.4.2     ✔ dplyr   0.7.5
✔ tidyr   0.8.1     ✔ stringr 1.3.1
✔ readr   1.1.1     ✔ forcats 0.3.0
── Conflicts ────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()

# R must be at least 3.3.1 for `tm` and `slam` to work.
# library("SnowballC")
library(tm)

Loading required package: NLP

Attaching package: ‘NLP’

The following object is masked from ‘package:ggplot2’:

    annotate

Before we get started working with the actual data, we’re going to create a custom function for plotting multiple ggplot graphs in a single image. This function was copied from Cookbook for R.

# Multiple plot function
#
# ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects)
# - cols:   Number of columns in layout
# - layout: A matrix specifying the layout. If present, 'cols' is ignored.
#
# If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE),
# then plot 1 will go in the upper left, 2 will go in the upper right, and
# 3 will go all the way across the bottom.
#
multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
  library(grid)
  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)
  numPlots = length(plots)
  # If layout is NULL, then use 'cols' to determine layout
  if (is.null(layout)) {
    # Make the panel
    # ncol: Number of columns of plots
    # nrow: Number of rows needed, calculated from # of cols
    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                    ncol = cols, nrow = ceiling(numPlots/cols))
  }
 if (numPlots==1) {
    print(plots[[1]])
  } else {
    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))
    # Make each plot, in the correct location
    for (i in 1:numPlots) {
      # Get the i,j matrix positions of the regions that contain this subplot
      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))
      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                      layout.pos.col = matchidx$col))
    }
  }
}

2 Reading in corpus

For this demonstration, I’ve selected a corpus of Shakespeare’s plays and adapted some code from a Kaggle notebook. Once you understand what the code here is doing, it can easily be adapted to a corpus of any structure or content.

We should take a look at how the corpus is structured so we know what we’re dealing with.

shak <- read.csv("../data/Shakespeare_data.csv",header = TRUE, as.is = TRUE)

These are the first ten lines of the corpus.

Each column is labeled and the content of the column is consistent for each row (all 111396 of them!). Some of the rows may not be useful. Some contain empty cells (labeled NA). Some contain a lot of information and we might need to do some processing on them before we can use the information quantitatively (for example the column PlayerLine).

3 Word frequency

The first thing we’ll look at is word frequency, or how often a string (in this case “love”) occurs in the data frame. To do this, we must identify every time the word “love” appears and highlight it in a way so that it can be counted based on different properties of its environment (e.g., by play, by player, by scene, etc).

Here are the first 10 rows of a data frame that contains the number of times “love” appears in each play. It’s been sorted in descending order, but doesn’t contain any other information about where and when the word occurs.

# play level word frequency
plays <- unique(shak$Play)
loveFreq<-numeric()
for (i in 1:length(plays)){
    text <- Corpus(VectorSource(paste(shak[shak$Play==plays[i],]$PlayerLine,collapse=" ")))
    text <- tm_map(text, removePunctuation)
    text <- tm_map(text, PlainTextDocument)
    text <- tm_map(text, removeWords, stopwords('english'))
    
    # stemming to merge all "loved", "loving" into one   
    text <- tm_map(text, stemDocument)
    tdm  <- TermDocumentMatrix(text)
    
    loveFreq[i]<-as.numeric(slam::row_sums(tdm)["love"]) # `slam` must be installed for this to work
  }
lPlay <- data.frame(plays,loveFreq)
lPlay <- na.omit(lPlay)
# order the plays based on the occurence of love
lPlay<-lPlay[order(-lPlay$loveFreq),]
lPlay

We can also look at which players say “love” the most over the course of their appearences. These are only the top 10 players who use the word “love” most.

# player level word frequency
players <- unique(shak$Player)
loveFreq <- numeric()
for (i in 1:length(players)){
    text <- Corpus(VectorSource(paste(shak[shak$Player==players[i],]$PlayerLine,collapse=" ")))
    text <- tm_map(text, removePunctuation)
    text <- tm_map(text, PlainTextDocument)
    text <- tm_map(text, removeWords, stopwords('english'))
    text <- tm_map(text,stemDocument)
    
    tdm  <- TermDocumentMatrix(text)
    
    loveFreq[i] <- as.numeric(slam::row_sums(tdm)["love"])
  }
lPlayer <- data.frame(players,loveFreq)
lPlayer <- na.omit(lPlayer)
#order
lPlayer <- lPlayer[order(-lPlayer$loveFreq),]
lPlayer

3.1 Exploring someone else’s code

Let’s go through the for-loop in more detail to understand what it’s doing.

How many players are in this vector? (Answer: 935)
That’s the number of times this for-loop will cycle, each time incrementing the loop number by 1.

for (i in 1:length(players)){

The first line of the loop uses Corpus() and VectorSource(). What do these functions do?
We can check the Help files by typing ?VectorSource(). It looks like both deal with the structure and metadata of a corpus. Importantly, we can see [i] in the code though. This is the same i from the previous line, which cycles through each of the players in the vector.
What does that tell us about the first pass through this loop?

text <- Corpus(VectorSource(paste(shak[shak$Player==players[i],]$PlayerLine,collapse=" ")))

The next few lines all use the function tm_map(), which performs a transformation on the corpus. In this case, the corpus is the subset we’ve called text in the above line. Judging from the syntax, it appears that they respectively remove punctuation from the text, convert it to a plain text document, remove English stop words, and merge all words with the same stems or lemmas (i.e., “love”, “loving”, “loved”, etc).

text <- tm_map(text, removePunctuation)
text <- tm_map(text, PlainTextDocument)
text <- tm_map(text, removeWords, stopwords('english'))
text <- tm_map(text, stemDocument)

This line turns the resulting vector into a term-document matrix, which is basically a way of identifying where each word occurs numerically, which will allow us to count the words in the next line.

tdm  <- TermDocumentMatrix(text)

A simple TDM may look like this:

	enter	exit	hamlet	ophelia	and
text_1	1	0	1	0	0
text_2	1	0	0	1	0
text_3	0	1	1	1	1

What might these three “texts” say?

The last line has several things going on. We can figure out what each function does by trying it on its own.

loveFreq[i] <- as.numeric(slam::row_sums(tdm)["love"])

First, we can see what tdm looks like when i = 1:

tdm

<<TermDocumentMatrix (terms: 27, documents: 2)>>
Non-/sparse entries: 27/27
Sparsity           : 50%
Maximal term length: 12
Weighting          : term frequency (tf)

Hmmm, that doesn’t look interpretable by a human. Maybe row_sums() from the package slam will help?

slam::row_sums(tdm)

         act       adjoin    antechamb        apart     bardolph        blunt 
           1            1            1            1            1            1 
   boarshead       cloten         earl    eastcheap        enter     falstaff 
           1            1            1            1            3            1 
       henri       imogen         john         king    lancaster       london 
           1            1            1            1            1            1 
        lord        other        palac        scene          sir       tavern 
           2            1            1            1            1            1 
         the       walter westmoreland 
           2            1            1 

Ah ha! That looks more intelligible. Which player is this for?
(Answer = ; if you want to see what different players are doing, you can change the value of i by hand and re-run the code.)

So what is ["love"] doing in the code?

slam::row_sums(tdm)["love"]

<NA> 
  NA 

Ah, “love” doesn’t exist in this row (where i = 1). Let’s see what it would look like if we were actually interested in “enter”:

slam::row_sums(tdm)["enter"]

enter 
    3 

There are two elements that are being printed out here: the word (“enter”) and the sum (3). That’s what as.numeric() will help us with:

as.numeric(slam::row_sums(tdm)["enter"])

[1] 3

This means that the sum of occurrences of “love” is now entered into index [i] in the vector loveFreq, and the loop begins again until i = length(players).

Finally, we close off the for-loop.

}

Can you figure out how to use the code above to create a data frame with the following two conditions?:

• A list of players
• Ordered by frequency of the word death

# create the vectors you need
# create the for-loop to calculate frequency
# create the data frame
# order the data frame from most to least frequent

(possible solution below)



























# create the vectors you need
# players <- unique(shak$Player) # <-- we already made this one before, but we can do it again too
deathFreq <- numeric() # <-- create a vector of class "numeric"

# create the for-loop to calculate frequency
for (i in 1:length(players)){
    text <- Corpus(VectorSource(paste(shak[shak$Player==players[i],]$PlayerLine,collapse=" ")))
    text <- tm_map(text, removePunctuation)
    text <- tm_map(text, PlainTextDocument)
    text <- tm_map(text, removeWords, stopwords('english'))
    text <- tm_map(text,stemDocument)
    
    tdm  <- TermDocumentMatrix(text)
    
    deathFreq[i] <- as.numeric(slam::row_sums(tdm)["death"])
  }

# create the data frame
dPlayer <- data.frame(players,deathFreq)
dPlayer <- na.omit(dPlayer)
# order the data frame from most to least frequent
dPlayer <- dPlayer[order(-dPlayer$deathFreq),]
dPlayer

4 Visualising a corpus

Maybe you are curious how the longer and shorter plays compare in word frequency. Instead of hand-counting each, we can graph and order them. Based on this graph, you don’t need to know exactly how long each is, but you can see that Othello is much longer than Loves Labours Lost, which can inform how you approach the comparison later on.

shak %>%
  # `Play` is the factor we are interested in
  group_by(Play) %>% 
  # summarise the content of `Play` by counting how many instances there are of each (`n`)
  summarise(n = n()) %>% 
  # reorder() allows us to sort them greatest to least
  ggplot(., aes(x=reorder(Play, n),y=n)) + 
    # stat="identity" is crucial for ggplot to know each `n` is the length of the bar
    geom_bar(stat="identity") + 
    # this way, the play names will be horizontal and fully displayed
    coord_flip() + 
    ggtitle("Length of Shakespeare's plays") +
    xlab("Play") +
    ylab("Number of lines")

4.1 Perception of frequency

Within a single play, maybe we want to know which characters are the chattiest. We can visualise the number of lines of text per character to get a sense of who is dominating the stage.

shak %>%
  filter(Play == "Hamlet") %>% # limit our dataset to only the play "Hamlet"
  group_by(Player) %>%
  summarise(n = n()) %>%
  ggplot(., aes(x=reorder(Player, n),y=n)) +
    geom_bar(stat="identity") +
    coord_flip() +
    ggtitle("Speech in Hamlet") +
    xlab("Player") +
    ylab("Number of lines") #+

    #scale_y_log10()

We can also look across plays for frequency. By comparing which plays have the word “love” the most often, we might be able to group them (perceptually) into plays about love and those that are not. Maybe?

lPlay %>%
  ggplot(., aes(x=reorder(plays, loveFreq),y=loveFreq)) +
    geom_bar(aes(),stat="identity") +
    coord_flip() +
    ggtitle("Love in each play") +
#    theme(legend.position="none") +
    xlab("Play") +
    ylab("frequency of the word 'love'") +
    theme(legend.position = "none")

4.2 Comparing across subsets

One thing that graphs can do very easily is give you a way to identify trends when you sort events (e.g., plays) into multiple different categories. For instance, the frequency graph above is interesting, but there are so many plays and as a non-expert, I can’t tell you what each is about, what style it is written in, or whether I’d expect it to be about “love” or not. So, we can add another dimension of information.

lPlayCat <- lPlay

# create boolean vectors for four play categories
comedies <- c("A Comedy of Errors",
            "As you like it",
            "Alls well that ends well",
            "Loves Labours Lost",
            "Measure for measure",
            "Merchant of Venice",
            "Merry Wives of Windsor",
            "A Midsummer nights dream",
            "Much Ado about nothing",
            "Taming of the Shrew",
            "Twelfth Night",
            "Two Gentlemen of Verona")
romances <- c("Pericles",
             "Cymbeline",
             "A Winters Tale",
             "The Tempest")
histories <- c("King John",
             "Richard II",
             "Richard III",
             "Henry IV",
             "Henry V",
             "Henry VI Part 1",
             "Henry VI Part 2",
             "Henry VI Part 3",
             "Henry VIII",
             "Coriolanus",
             "Julius Caesar",
             "Antony and Cleopatra",
             "King Lear",
             "macbeth")
tragedies <- c("Titus Andronicus",
             "Romeo and Juliet",
             "Hamlet",
             "Troilus and Cressida",
             "Othello",
             "Timon of Athens")
# create boolean vectors for four play categories
comedy <- lPlayCat$plays %in% comedies
romance <- lPlayCat$plays %in% romances
history <- lPlayCat$plays %in% histories
tragedy <- lPlayCat$plays %in% tragedies

# create new column with these four categories
lPlayCat <- lPlay %>%
  mutate(category = case_when(comedy == TRUE ~ "comedy",
                              romance == TRUE ~ "romance",
                              history == TRUE ~ "history",
                              tragedy == TRUE ~ "tragedy"))

In the following graph, each color represents a different category (as determined by Wikipedia’s First Folio page, plus information about the “late romances”). Now, we can see if there are trends for different categories to mention “love” more or less than the others.

lPlayCat %>%
  ggplot(., aes(x=reorder(plays, loveFreq),y=loveFreq)) +
    geom_bar(aes(fill=category),stat="identity") +
    coord_flip() +
    ggtitle("Love in each play") +
#    theme(legend.position="none") +
    xlab("Play") +
    ylab("frequency of the word 'love'")

It seems to me that comedies and tragedies discuss “love” the most, whereas histories and the late romances discuss it the least. Is this intuitive? Maybe. But there’s a problem. A Comedy of Errors has the fewest mentions of “love”, but it’s also the shortest play, so it has the fewest words overall. What we really want to see is the proportion of “love”-frequency per play, not the raw counts. To do that, we have to add in the total length of each play to the data frame, but we’ve lost that information in lPlayCat and lPlay. How might you add that information in to the lPlayCat dataframe?

(possible solution below)



























# create new data frame for lengths of plays
playLength <- shak %>%
  group_by(Play) %>%
  summarise(n = n()) %>%
  transmute(plays=Play,length=n) # rename columns that we want, which happens to be both of them
# add column to lPlayCat
lPlayCatLen <- lPlayCat %>%
  left_join(.,playLength)

Joining, by = "plays"
Column `plays` joining factor and character vector, coercing into character vector

Now we can take a look to see how raw and proportional graphs compare.

lPlayCatLen %>%
  mutate(proportion = loveFreq/length) %>%
  ggplot(., aes(x=reorder(plays, proportion),y=proportion)) +
    geom_bar(aes(fill=category),stat="identity") +
    coord_flip() +
    ggtitle("Love in each play") +
#    theme(legend.position="none") +
    xlab("Play") +
    ylab("proportional frequency of the word 'love'")

Not a whole lot has changed, but I think the distribution of comedies and tragedies is even more pronounced. And, we have more information about A Comedy of Errors, which is still very close to the bottom of the graph. Not every comedy is about love, it seems.

Finally, we can generate these same types of graphs for different subgroups, too. We’ll have to add in $category to shak as well, but we already have the vectors for each level of category, so it’s pretty easy to do.

# create boolean vectors for four play categories in `shak`
comedy  <- shak$Play %in% comedies
romance <- shak$Play %in% romances
history <- shak$Play %in% histories
tragedy <- shak$Play %in% tragedies
# create new column with these four categories
shakCat <- shak %>%
  mutate(category = case_when(comedy == TRUE ~ "comedy",
                              romance == TRUE ~ "romance",
                              history == TRUE ~ "history",
                              tragedy == TRUE ~ "tragedy"))

Here’s one example, where we look at the number of lines each player has, focusing only on players who have greater than 700 lines. We can also see if there are any trends in these top speakers by play category. It seems to me that the histories dominate, but Hamlet and Iago dominate the scene (so to speak).

shakCat %>%
  group_by(Play,Player,category) %>%
  summarise(n = n()) %>%
  filter(n > 700) %>%
  ggplot(., aes(x=reorder(Player, n),y=n)) +
    geom_bar(aes(fill=category),stat="identity") +
    coord_flip() +
    ggtitle("Number of lines by character") +
#    theme(legend.position="none") +
    xlab("Player") +
    ylab("Number of lines")

Is this because histories and tragedies tend to be longer plays, overall? Quite possibly:

shakCat %>%
  group_by(Play,category) %>%
  summarise(n = n()) %>%
  ggplot(., aes(x=reorder(Play, n),y=n)) +
    geom_bar(aes(fill=category),stat="identity") +
    coord_flip() +
    ggtitle("Length of Shakespeare's plays") +
    theme(legend.position="none") +
    xlab("Play") +
    ylab("Number of lines")

5 N-grams

Single words might not be able to tell us much about the texts, which is why examining collocations is such a popular technique. What’s the difference between “the king”, “kill the king”, and “kiss the king”? A lot, but we won’t know if we only look for instances of “king”. There is where n-grams become useful. N-grams are sets of adjacent words, calculated by assigning a number to ‘n’. That is, if we want sets of two words, we talk about bigrams. If we want sets of three words, we talk about trigrams.

5.1 Pre-processing the corpus

First, we can look at the corpus as a list of words, rather than a list of lines (by act and scene). What is unnest_tokens() doing here?

Now, we can automate the process of counting how often each word occurs. But, of course, certain words are going to be extremely common, and those words are unlikely to be informative.

Once we’ve filtered out our stop-words, the most frequent words look quite different.

shak %>%
  unnest_tokens(input = PlayerLine, output = word) %>%
  anti_join(stop_words, by = "word") %>%
  count(word, sort = TRUE)

However, Shakespeare uses a lot of words that aren’t in our default stop-word list, so we can append our own custom list.

word <- c(NA,"thou","thee","thy","thine","dost","shalt","wilt","hast","hath","scene","tis","ii","iii","iv","v","vi","vii")
lexicon <- rep("shakespeare",length(word))
new_stop <- cbind(word,lexicon)
shak_stop <- rbind(new_stop,stop_words)

Here is a visualisation of how stop words affect the corpus.

p1 <- shak %>%
  as_tibble(.) %>%
  unnest_tokens(tbl=., input = PlayerLine, output = word) %>%
  count(word, sort = TRUE) %>%
  filter(n>800) %>%
  ggplot(., aes(x=reorder(word,n),y=n)) +
    geom_bar(stat="identity") +
    coord_flip() +
    ggtitle("No stop words")
p2 <- shak %>%
  as_tibble(.) %>%
  unnest_tokens(tbl=., input = PlayerLine, output = word) %>%
  anti_join(stop_words) %>%
  count(word, sort = TRUE) %>%
  filter(n>800) %>%
  ggplot(., aes(x=reorder(word,n),y=n)) +
    geom_bar(stat="identity") +
    coord_flip() +
    ggtitle("Default stop words")
p3 <- shak %>%
  as_tibble(.) %>%
  unnest_tokens(tbl=., input = PlayerLine, output = word) %>%
  anti_join(shak_stop) %>%
  count(word, sort = TRUE) %>%
  filter(n>800) %>%
  ggplot(., aes(x=reorder(word,n),y=n)) +
    geom_bar(stat="identity") +
    coord_flip() +
    ggtitle("Custom stop words")

Column `word` joining character vector and factor, coercing into character vector

multiplot(p1,p2,p3,cols=3)

5.2 Comparing across plays

Before we try to compare across plays, let’s see what the most common bigrams are overall (after being filtered by the custom stop words list).

shak %>%
  unnest_tokens(input = PlayerLine, output = bigram, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>% # separates bigram into two columns, one for each word
  filter(!word1 %in% shak_stop$word) %>% # filters stop words from first column
  filter(!word2 %in% shak_stop$word) %>% # filters stop words from second column
  count(word1, word2, sort = TRUE)

5.2.1 1-grams (just regular token frequency)

If we choose a subset of words, we can look at how they are distributed across different plays. In this case, we can compare death, king, love, and sweet across six plays. Unsurprisingly, Romeo and Juliet uses the word love more than any other play, although Midsummer Night’s Dream is close. King is also much more common in plays about kings (surprise, surprise).

shak[,c(2,5,6)] %>%
  as_tibble() %>%
  unnest_tokens(tbl=., input = PlayerLine, output = word) %>%
  filter(word=="love" | word =="king" | word=="death" | word=="sweet") %>%
  group_by(Player,Play,word) %>%
  summarise(n=n()) %>%
  filter(  Play == "Hamlet" | 
           Play == "King Lear" | 
           Play == "A Midsummer nights dream" | 
           Play == "Othello" | 
           Play == "Henry V" | 
           Play == "Romeo and Juliet") %>%
  arrange(desc(n)) %>%
  ggplot(., aes(x=word,y=n)) +
    geom_bar(aes(fill=word),stat="identity") +
    facet_wrap(~Play)

But there are more interesting words you could compare, certainly. These are just one example.

5.2.2 Bigrams

It’s probably much more interesting to look at collocation than simple word frequency. After all, it gives more context. However, it also reduces the number of tokens substantially.

Here, we can visualise three pairs of gendered noun phrases:

Masculine	Feminine
my lord	my lady
my father	my mother
my husband	my wife

What kinds of information can we see in the graph?

shak %>%
  as_tibble() %>%
  unnest_tokens(input = PlayerLine, output = bigram, token = "ngrams", n = 2) %>%
  filter(bigram=="my lord" | bigram =="my lady" | bigram=="my mother" | bigram=="my father" | bigram=="my wife" | bigram=="my husband") %>%
  mutate(gender = bigram) %>%
  mutate(gender = recode_factor(gender,
                `my lord`="masc",
                `my father`="masc",
                `my husband`="masc",
                `my lady`="fem",
                `my mother`="fem",
                `my wife`="fem")) %>%
  group_by(Player,Play,bigram,gender) %>%
  summarise(n=n()) %>%
  mutate(bigramFac = factor(bigram, levels=c("my lord", "my husband", "my father", "my lady", "my wife", "my mother"))) %>%
  # too boring
  filter(  Play != "Henry VI Part 1" &
           Play != "Henry VI Part 2" &
           Play != "Henry VI Part 3" &
           Play != "Pericles" & 
           Play != "Timon of Athens" & 
           Play != "The Tempest") %>%
  # too skewed
  filter(  Play != "Hamlet" &
           Play != "Troilus and Cressida" &
           Play != "Richard III" &
           Play != "Titus Andronicus" & 
           Play != "Henry VIII" & 
           Play != "Much Ado about nothing") %>%
  arrange(desc(n)) %>%
  ggplot(., aes(x=bigramFac,y=n)) +
    geom_bar(aes(fill=gender),stat="identity") +
    scale_y_log10() +
    coord_flip() +
    facet_wrap(~Play,nrow=3)

5.3 Networks

#install.packages("igraph")
#install.packages("ggraph")
library(igraph)

Attaching package: ‘igraph’

The following objects are masked from ‘package:dplyr’:

    as_data_frame, groups, union

The following objects are masked from ‘package:purrr’:

    compose, simplify

The following object is masked from ‘package:tidyr’:

    crossing

The following object is masked from ‘package:tibble’:

    as_data_frame

The following objects are masked from ‘package:stats’:

    decompose, spectrum

The following object is masked from ‘package:base’:

    union

library(ggraph)
library(grid)
a <- grid::arrow(type = "closed", angle=22.5, length = unit(.1, "inches"))

I think the most exciting way to use n-grams is probably network graphs. These graphs show what words co-occur, and in what order. Moreover, they can encode a number of dimensions visually, which would be very difficult to calculate by hand or plot in a more standard quantitative method.

5.3.1 Bigrams

From the list of bigrams we can generate from our corpus, we can plot a network graph in which the shade of the connection between nodes indicates the frequency of the bigram (darker means more frequent). Moreover, these connections (“edges”) are directional, so we can see which order the words are occuring in.

shak %>%
  unnest_tokens(input = PlayerLine, output = bigram, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>% # separates bigram into two columns, one for each word
  filter(!word1 %in% shak_stop$word) %>% # filters stop words from first column
  filter(!word2 %in% shak_stop$word) %>% # filters stop words from second column
  count(word1, word2, sort = TRUE) %>%
  filter(n > 22) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
    geom_edge_link(aes(edge_alpha = n), edge_colour="darkblue", show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
    geom_node_point(color = "lightblue", size = 5) +
    geom_node_text(aes(label = name), repel=TRUE) + 
    theme_void()

We can also use these plots to compare across plays (although token frequency begins to drop precipitously). Here, we can see that Twelfth Night has notable connections between items of clothing (yellow stockings, cross gartered), whereas Hamlet and Romeo and Juliet have more tokens referring to people and their stage directions. Hamlet additionally has a notable number of “father’s death” bigrams, while Romeo and Juliet mentions “county Paris” frequently.

p1 <- shak %>%
  filter(Play=="Hamlet") %>%
  unnest_tokens(input = PlayerLine, output = bigram, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>% # separates bigram into two columns, one for each word
  filter(!word1 %in% shak_stop$word) %>% # filters stop words from first column
  filter(!word2 %in% shak_stop$word) %>% # filters stop words from second column
  count(word1, word2, sort = TRUE) %>%
  filter(n > 6) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
    geom_edge_link(aes(edge_alpha = n), edge_colour="darkblue", show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
    geom_node_point(color = "lightblue", size = 5) +
    geom_node_text(aes(label = name), repel=TRUE) + 
    theme_void()
p2 <- shak %>%
  filter(Play == "Twelfth Night") %>%
  unnest_tokens(input = PlayerLine, output = bigram, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>% # separates bigram into two columns, one for each word
  filter(!word1 %in% shak_stop$word) %>% # filters stop words from first column
  filter(!word2 %in% shak_stop$word) %>% # filters stop words from second column
  count(word1, word2, sort = TRUE) %>%
  filter(n > 6) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
    geom_edge_link(aes(edge_alpha = n), edge_colour="darkred", show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
    geom_node_point(color = "salmon", size = 5) +
    geom_node_text(aes(label = name), repel=TRUE) + 
    theme_void()
p3 <- shak %>%
  filter(Play == "Romeo and Juliet") %>%
  unnest_tokens(input = PlayerLine, output = bigram, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>% # separates bigram into two columns, one for each word
  filter(!word1 %in% shak_stop$word) %>% # filters stop words from first column
  filter(!word2 %in% shak_stop$word) %>% # filters stop words from second column
  count(word1, word2, sort = TRUE) %>%
  filter(n > 6) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
    geom_edge_link(aes(edge_alpha = n), edge_colour="darkgreen", show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
    geom_node_point(color = "green2", size = 5) +
    geom_node_text(aes(label = name), repel=TRUE) + 
    theme_void()
multiplot(p1,p2,p3,cols=3)

If we exclude stage directions and compare across six plays, we start to see distinct themes appear.

Using multiplot, try plotting the following six graphs in a 3 by 2 matrix:

1. Hamlet
2. Twelfth Night
3. Romeo and Juliet
4. Othello
5. Henry IV
6. The Tempest

Make sure each meets the following conditions:

• no stage directions
• bigrams with frequency greater than 3
• each with a different colour

Remember: reusing code and adapting someone else’s (open source) code is encouraged! Always cite where appropriate.

# 1. Hamlet

# 2. Twelfth Night

# 3. Romeo and Juliet

# 4. Othello

# 5. Henry IV

# 6. The Tempest

(possible solution below)



























p1 <- shak %>%
  filter(ActSceneLine != "") %>%
  filter(Play=="Hamlet") %>%
  unnest_tokens(input = PlayerLine, output = bigram, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>% # separates bigram into two columns, one for each word
  filter(!word1 %in% shak_stop$word) %>% # filters stop words from first column
  filter(!word2 %in% shak_stop$word) %>% # filters stop words from second column
  count(word1, word2, sort = TRUE) %>%
  filter(n > 3) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
    geom_edge_link(aes(edge_alpha = n), edge_colour="darkblue", show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
    geom_node_point(color = "lightblue", size = 5) +
    geom_node_text(aes(label = name), repel=TRUE) + 
    theme_void() +
    ggtitle("Hamlet")
p2 <- shak %>%
  filter(ActSceneLine != "") %>%
  filter(Play == "Twelfth Night") %>%
  unnest_tokens(input = PlayerLine, output = bigram, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>% # separates bigram into two columns, one for each word
  filter(!word1 %in% shak_stop$word) %>% # filters stop words from first column
  filter(!word2 %in% shak_stop$word) %>% # filters stop words from second column
  count(word1, word2, sort = TRUE) %>%
  filter(n > 3) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
    geom_edge_link(aes(edge_alpha = n), edge_colour="darkred", show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
    geom_node_point(color = "salmon", size = 5) +
    geom_node_text(aes(label = name), repel=TRUE) + 
    theme_void() +
    ggtitle("Twelfth Night")
p3 <- shak %>%
  filter(ActSceneLine != "") %>%
  filter(Play == "Romeo and Juliet") %>%
  unnest_tokens(input = PlayerLine, output = bigram, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>% # separates bigram into two columns, one for each word
  filter(!word1 %in% shak_stop$word) %>% # filters stop words from first column
  filter(!word2 %in% shak_stop$word) %>% # filters stop words from second column
  count(word1, word2, sort = TRUE) %>%
  filter(n > 3) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
    geom_edge_link(aes(edge_alpha = n), edge_colour="darkgreen", show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
    geom_node_point(color = "green2", size = 5) +
    geom_node_text(aes(label = name), repel=TRUE) + 
    theme_void() +
    ggtitle("Romeo and Juliet")
p4 <- shak %>%
  filter(ActSceneLine != "") %>%
  filter(Play == "Othello") %>%
  unnest_tokens(input = PlayerLine, output = bigram, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>% # separates bigram into two columns, one for each word
  filter(!word1 %in% shak_stop$word) %>% # filters stop words from first column
  filter(!word2 %in% shak_stop$word) %>% # filters stop words from second column
  count(word1, word2, sort = TRUE) %>%
  filter(n > 3) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
    geom_edge_link(aes(edge_alpha = n), edge_colour="darkorange", show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
    geom_node_point(color = "orange", size = 5) +
    geom_node_text(aes(label = name), repel=TRUE) + 
    theme_void() +
    ggtitle("Othello")
p5 <- shak %>%
  filter(ActSceneLine != "") %>%
  filter(Play == "Henry IV") %>%
  unnest_tokens(input = PlayerLine, output = bigram, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>% # separates bigram into two columns, one for each word
  filter(!word1 %in% shak_stop$word) %>% # filters stop words from first column
  filter(!word2 %in% shak_stop$word) %>% # filters stop words from second column
  count(word1, word2, sort = TRUE) %>%
  filter(n > 3) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
    geom_edge_link(aes(edge_alpha = n), edge_colour="cadetblue4", show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
    geom_node_point(color = "cyan", size = 5) +
    geom_node_text(aes(label = name), repel=TRUE) + 
    theme_void() +
    ggtitle("Henry IV")
p6 <- shak %>%
  filter(ActSceneLine != "") %>%
  filter(Play == "The Tempest") %>%
  unnest_tokens(input = PlayerLine, output = bigram, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>% # separates bigram into two columns, one for each word
  filter(!word1 %in% shak_stop$word) %>% # filters stop words from first column
  filter(!word2 %in% shak_stop$word) %>% # filters stop words from second column
  count(word1, word2, sort = TRUE) %>%
  filter(n > 3) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
    geom_edge_link(aes(edge_alpha = n), edge_colour="violet", show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
    geom_node_point(color = "magenta", size = 5) +
    geom_node_text(aes(label = name), repel=TRUE) + 
    theme_void() +
    ggtitle("The Tempest")
multiplot(p1,p2,p3,p4,p5,p6,cols=3)

6 Heatmaps

Another visualisation tool that can be very helpful for showing distributions of events across a structure is the heatmap. A heatmap is a complex histogram, which allows multiple subsets of the data to be compared side-to-side. In this example, we can look at the variability of length of subsections (acts and scenes) as determined by number of words. It is much easier and quicker to extract this information from a heatmap (although the precise numbers are lost in this version).

Let’s focus in on a subset of plays in order to simplify the visualisation. From a simple visual inspection, it appears that Act V tends to be the lightest on words, with the very notable exception of Love’s Labour’s Lost. Otherwise, Act I is generally fairly heavy on words, and Act II tends to be a bit lighter. Armed with that (superficial) observation, we might be able to check whether our eyes deceive us or whether there’s something to it. (But I’ll leave that exploration for another time.)

shak %>%
  filter(Play == "Hamlet" | Play == "King John" | 
           Play == "The Tempest" | Play == "Cymbeline" | 
           Play == "Measure for measure" | Play == "Timon of Athens" | 
           Play == "Richard III" | Play == "Loves Labours Lost" | 
           Play == "A Winters Tale" | Play == "Othello" | 
           Play == "Romeo and Juliet" | Play == "Henry V") %>% 
  filter(ActSceneLine != "") %>%
  mutate(ActSceneLine2 = ActSceneLine) %>%
  separate(ActSceneLine2, c("act", "scene", "line")) %>%
  count(Play,act, sort=TRUE) %>%
  transmute(play=Play, act=as.integer(act), n=n) %>%
  ggplot(aes(x=act,y=reorder(play, n))) + 
    geom_tile(aes(fill = n), colour = "white") + scale_fill_gradient(low = "white", high = "steelblue")

Maybe there is some pattern we can detect by plotting the number of words by scene, by act, and by player within a single play (Hamlet). This figure is able to communicate a tremendous amount of information in a very small space by illustrating where each character has the bulk of their lines. Here, we can see Hamlet is positively verbose in Scene II in Acts II, III, V, but otherwise only marginally wordier than the other players. Moreover, there seems to be the most even distribution of lines (neither very dark nor entirely pale, as colour-coded) in Act I, whereas the other acts are quite skewed toward the few main players.

shak %>%
  filter(Play == "Hamlet") %>% 
  filter(ActSceneLine != "") %>%
  mutate(ActSceneLine2 = ActSceneLine) %>%
  separate(ActSceneLine2, c("act", "scene", "line")) %>%
  count(Player,act,scene, sort=TRUE) %>%
  transmute(player=Player, act=as.integer(act), scene=as.integer(scene), n=n) %>%
  ggplot(aes(x=scene,y=reorder(player,n))) + 
    geom_tile(aes(fill = n), colour = "white") + 
    scale_fill_gradient(low = "white", high = "red2") +
    scale_x_continuous(breaks=c(0:8)) +
    theme_dark() + 
    facet_wrap(~act, ncol = 5)

Now, choose a different play and create your own version of this kind of graph. What can you learn about the contribution of each of the players from the distribution of their lines?